home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s2.arc / KOPEN.MOD < prev    next >
Text File  |  1987-07-15  |  10KB  |  250 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         Open_File --- Open file for use by Kermit protocol routines  *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Open_File(     File_Mode : Kermit_File_Modes;
  6.                          FileName  : AnyStr;
  7.                      VAR FullName  : AnyStr             );
  8.  
  9. (*----------------------------------------------------------------------*)
  10. (*                                                                      *)
  11. (*     Procedure:  Open_File                                            *)
  12. (*                                                                      *)
  13. (*     Purpose:    Opens file for use by Kermit routines                *)
  14. (*                                                                      *)
  15. (*     Calling Sequence:                                                *)
  16. (*                                                                      *)
  17. (*        Open_File(     File_Mode : Kermit_File_Modes;                 *)
  18. (*                       FileName  : AnyStr;                            *)
  19. (*                   VAR FullName  : AnyStr  );                         *)
  20. (*                                                                      *)
  21. (*           File_Mode --- whether file is to be opened for read or     *)
  22. (*                         write                                        *)
  23. (*           FileName  --- name of file to open                         *)
  24. (*           FullName  --- actual name used in open                     *)
  25. (*                                                                      *)
  26. (*     Calls:                                                           *)
  27. (*                                                                      *)
  28. (*        Adjust_Fn                                                     *)
  29. (*        Open_For_Write                                                *)
  30. (*        Int24Result                                                   *)
  31. (*                                                                      *)
  32. (*----------------------------------------------------------------------*)
  33.  
  34. VAR
  35.    Count     : INTEGER;
  36.    Space_Pos : INTEGER;
  37.    New_Name  : AnyStr;
  38.    F         : FILE OF BYTE;
  39.    Err       : INTEGER;
  40.    Save_Name : AnyStr;
  41.    IPos      : INTEGER;
  42.  
  43. (*----------------------------------------------------------------------*)
  44. (*                Open_For_Write --- Open file for output               *)
  45. (*----------------------------------------------------------------------*)
  46.  
  47. PROCEDURE Open_For_Write(     FileName : AnyStr;
  48.                           VAR Open_OK  : BOOLEAN  );
  49.  
  50. BEGIN (* Open_For_Write *)
  51.                                    (* Check if file exists *)
  52.  
  53.    IF ( POS( ':' , FileName ) = 0 ) AND
  54.       ( POS( '\' , FileName ) = 0 ) THEN
  55.       FullName := Download_Dir_Path + FileName;
  56.  
  57.    ASSIGN( F, FullName );
  58.       (*$I-*)
  59.    RESET( F );
  60.       (*$I+*)
  61.                                    (* Error if file exists *)
  62.    IF Int24Result = 0 THEN
  63.       BEGIN
  64.          Open_OK := FALSE;
  65.             (*$I-*)
  66.          CLOSE( F );
  67.             (*$I+*)
  68.          Err := Int24Result;
  69.       END
  70.    ELSE                            (* Otherwise, new file -- open it *)
  71.       BEGIN
  72.  
  73.          Err := Create_File_Handle( FullName, Attribute_None, XFile_Handle );
  74.  
  75.          IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  76.             Open_OK := FALSE
  77.          ELSE
  78.             BEGIN (* FileName is new file, open it *)
  79.  
  80.                File_Records := 0.0;
  81.                Open_OK      := TRUE;
  82.                File_Open    := TRUE;
  83.                Buffer_Num   := 0.0;
  84.  
  85.             END;
  86.  
  87.       END;
  88.  
  89. END    (* Open_For_Write *);
  90.  
  91. (*----------------------------------------------------------------------*)
  92. (*                  Open_For_Read --- Open file for input               *)
  93. (*----------------------------------------------------------------------*)
  94.  
  95. PROCEDURE Open_For_Read(     FileName : AnyStr;
  96.                          VAR Open_OK  : BOOLEAN  );
  97.  
  98. VAR
  99.    KDate    : INTEGER;
  100.    KTime    : INTEGER;
  101.    Save_Date: Date_Format_Type;
  102.    Save_Time: Time_Format_Type;
  103.    I        : INTEGER;
  104.  
  105. BEGIN (* Open_For_Read *)
  106.                                    (* Append upload path if needed *)
  107.  
  108.    IF ( POS( ':' , FileName ) = 0 ) AND
  109.       ( POS( '\' , FileName ) = 0 ) THEN
  110.       FullName := Upload_Dir_Path + FileName
  111.    ELSE
  112.       FullName := FileName;
  113.  
  114.                                    (* Try opening file *)
  115.    ASSIGN( F, FullName );
  116.       (*$I-*)
  117.    RESET( F );
  118.       (*$I+*)
  119.                                    (* If there, close and open with file *)
  120.                                    (* handle.                            *)
  121.    IF ( Int24Result = 0 ) THEN
  122.       BEGIN
  123.                                    (* Indicate file opened OK *)
  124.          Open_OK      := TRUE;
  125.          File_Open    := TRUE;
  126.                                    (* Pick up file size       *)
  127.  
  128.          File_Records := LongFileSize( F );
  129.  
  130.          STR( File_Records : 10 : 0 , Kermit_CFile_Size );
  131.  
  132.          WHILE ( POS( ' ' , Kermit_CFile_Size ) > 0 ) DO
  133.             DELETE( Kermit_CFile_Size, POS( ' ' , Kermit_CFile_Size ), 1 );
  134.  
  135.                                    (* Display it if status display on *)
  136.  
  137.          IF Display_Status THEN
  138.             BEGIN
  139.                GoToXY( 25 , 4 );
  140.                WRITE ( Kermit_CFile_Size );
  141.                ClrEol;
  142.             END;
  143.                                    (* No characters sent yet *)
  144.          Buffer_Num   := 0.0;
  145.                                    (* Close file as file of byte, *)
  146.          CLOSE( F );
  147.                                    (* and open using file handle. *)
  148.  
  149.          Err := Open_File_Handle( FullName, Access_Read_Mode, XFile_Handle );
  150.  
  151.                                    (* Get file date and time for  *)
  152.                                    (* attribute packet.           *)
  153.  
  154.                                    (* --- Get date/time from DOS  *)
  155.  
  156.          Err := Dir_Get_File_Date_And_Time( XFile_Handle, KDate, KTime );
  157.  
  158.                                    (* --- Save current time/date formats *)
  159.  
  160.          Save_Date := Date_Format;
  161.          Save_Time := Time_Format;
  162.                                    (* --- Set time/date formats we want  *)
  163.          Date_Format := YMD_Style;
  164.          Time_Format := Military_Time;
  165.  
  166.                                    (* --- Get character form of date/time *)
  167.  
  168.          Dir_Convert_Date( KDate , Kermit_CFile_Date );
  169.          Dir_Convert_Time( KTime , Kermit_CFile_Time );
  170.  
  171.                                    (* --- Restore proper date/time formats *)
  172.  
  173.          Date_Format := Save_Date;
  174.          Time_Format := Save_Time;
  175.                                    (* --- Strip slashes from date      *)
  176.  
  177.          WHILE ( POS( '/' , Kermit_CFile_Date ) > 0 ) DO
  178.             DELETE( Kermit_CFile_Date , POS( '/' , Kermit_CFile_Date ), 1 );
  179.  
  180.          Kermit_CFile_Date := '19' + Kermit_CFile_Date;
  181.  
  182.                                    (* Indicate what file we're sending *)
  183.  
  184.          Write_Log('Sending file ' + FileName , TRUE , FALSE);
  185.  
  186.       END
  187.    ELSE
  188.       BEGIN
  189.          Open_OK := FALSE;
  190.          Display_Kermit_Message( 'File ' + FileName + ' does not exist.');
  191.       END;
  192.  
  193. END    (* Open_For_Read *);
  194.  
  195. (*----------------------------------------------------------------------*)
  196.  
  197. BEGIN (* Open_File *)
  198.                                    (* Remember original file name    *)
  199.  
  200.    Save_Name := UpperCase( FileName );
  201.    FullName  := '';
  202.                                    (* Select open based upon whether *)
  203.                                    (* file is to be read or written  *)
  204.    CASE File_Mode OF
  205.  
  206.                                    (* Open file for reading *)
  207.  
  208.       Read_Open : Open_For_Read( FileName, Open_OK );
  209.  
  210.                                    (* Open file for writing *)
  211.       Write_Open: BEGIN
  212.                                    (* Ensure legal file name          *)
  213.  
  214.                      FileName := Fix_File_Name( FileName );
  215.  
  216.                                    (* Try opening under provided name *)
  217.  
  218.                      Open_For_Write( FileName, Open_OK );
  219.  
  220.                                    (* If file exists (Open_OK = FALSE), *)
  221.                                    (* then try adjusting name until     *)
  222.                                    (* non-existent name found.          *)
  223.  
  224.                      New_Name := FileName;
  225.  
  226.                      IF ( NOT Open_OK ) THEN
  227.                         IF Kermit_Adjust_File_Name( FileName , New_Name ) THEN
  228.                            Open_For_Write( New_Name , Open_OK );
  229.  
  230.                      IF Open_OK THEN
  231.                         BEGIN
  232.                            IF ( New_Name <> Save_Name ) THEN
  233.                               Display_Kermit_Message_2('Filename ' +
  234.                                                         Save_Name  +
  235.                                                        ' changed to: ' +
  236.                                                         New_Name );
  237.                            Write_Log('Receiving file ' + FileName , TRUE , FALSE);
  238.  
  239.                         END
  240.                      ELSE
  241.                         Display_Kermit_Message_2('Filename ' +
  242.                                                   Save_Name  +
  243.                                                  ' could not be opened.');
  244.  
  245.                   END    (* Write_Open *);
  246.  
  247.    END (* CASE *);
  248.  
  249. END     (* Open_File *);
  250.